home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / T123V13.ARJ / TAB123.LSP < prev    next >
Lisp/Scheme  |  1992-05-07  |  7KB  |  246 lines
  1. ;;; *========================[ Tab123.LSP ]==============================*
  2. ;;;
  3. ;;; Tab123 creates a table in AutoCAD from a Lotus 123 file.
  4. ;;; Read_WKS.EXE must be on the DOS path, and SHELL must provide
  5. ;;; at least 150K of free memory for Read_WKS.EXE to execute.
  6. ;;;
  7. ;;; by Jerry Workman, CopyRight (c) Mountain Software, 1991,92
  8. ;;; version 1.3
  9. ;;; *====================================================================*
  10.  
  11. ;;; Initalize Globals
  12.  
  13. (If (Not rsf)
  14.   (SetQ rsf 2.0
  15.         cof 1.0))
  16.  
  17. ;;; Our error routine
  18.  
  19. (defun AtErr(s)
  20.   (If (/= s "Function cancelled")
  21.       (Princ (StrCat "\nError: " s))
  22.   )
  23.   (moder)                             ; Restore modified modes
  24.   (If (= (Type fp) 'FILE) (SetQ fp (Close rtfile)))
  25.   (setq *error* olderr)               ; Restore old *error* handler
  26.   (princ)
  27. )
  28.  
  29. ;;; swiped this from ADESK
  30.  
  31. (defun Modes (a)
  32.    (setq MLST '())
  33.    (repeat (length a)
  34.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  35.       (setq a (cdr a)))
  36. )
  37.  
  38. ;;; and this
  39.  
  40. (defun Moder ()
  41.    (repeat (length MLST)
  42.       (setvar (caar MLST) (cadar MLST))
  43.       (setq MLST (cdr MLST))
  44.    )
  45. )
  46.  
  47. ;;; Draw a grid around the table
  48.  
  49. (Defun DrawGrid ( / gx gy r c)
  50.   (SetQ gx sx chars 0 r 0 c 0)
  51.   ; Calculate horizontal line length
  52.   (princ(strcat "\nDrawing a " (itoa cols) " column by "
  53.     (itoa rows) " row grid..."))
  54.   (ForEach c colwid (SetQ chars (+ chars c)))
  55.   ; Draw Horizontal Lines
  56.   (SetQ x2 (+ sx (* cols (* 2 CharOS)) (* chars CharSiz)))
  57.   (Command ".LINE" (List sx sy) (List x2 sy) "")
  58.   (Command ".ARRAY" "L" "" "R" (1+ rows) 1 (* -1 rc))
  59.   ; Draw Vertical lines
  60.   (SetQ y2 (- sy (* rows rc)))
  61.   (While (<= c cols) (Progn
  62.     (If(> c 0)
  63.       (SetQ cw  (Nth (1- c) colwid)
  64.             gx  (+ gx (* 2 CharOS) (* cw CharSiz)))
  65.     )
  66.     (SetQ pt1 (List gx sy)
  67.           pt2 (List gx y2)
  68.     )
  69.     (Command ".line" pt1 pt2 "")
  70.     (SetQ c (1+ c))
  71.   ))
  72. )
  73.  
  74. ;;; Draw the text entities from ACAD.123
  75.  
  76. (Defun c:DrawTab ()
  77.   (setq olderr  *error*
  78.         *error* AtErr)
  79.   (Modes '("BLIPMODE" "CMDECHO"))
  80.   (SetVar "BLIPMODE" 0)
  81.   (SetVar "CMDECHO" 0)
  82.   (If (Null (SetQ fp (open "ACAD.123" "r")))
  83.     (Princ "\nError: Can't open file \"ACAD.123\"")
  84.   ;else
  85.     (Progn
  86.       (SetQ line (Read-Line fp))          ; size of table
  87.       (If line (Progn
  88.         (SetQ size (read line))
  89.         (graphscr)
  90.         (prompt "\nTable file \"ACAD.123\" opened...")
  91.         (SetQ pt (getpoint "\nTable Insertion point: "))
  92.  
  93.         ;*----Prompt for a text height
  94.         (SetQ ts (tblsearch "STYLE" (getvar "TEXTSTYLE"))
  95.               h nil
  96.         )
  97.         (If (= (Cdr (Assoc 40 ts)) 0.0)
  98.           (Progn
  99.             (InitGet 6)
  100.             (SetQ h (GetDist pt (strcat "\nText Height <"
  101.                                         (rtos (getvar "TEXTSIZE"))
  102.                                         ">: "
  103.                                 )
  104.                     )
  105.             )
  106.             (If (Null h)
  107.               (SetQ h (getvar "TEXTSIZE")))
  108.             (SetQ hmode nil)
  109.           ) ;else
  110.           (SetQ h (Cdr (Assoc 40 ts))
  111.                 hmode 1)
  112.         )
  113.         (SetQ sx  (Car pt)
  114.               sy  (Cadr pt)
  115.               rc  (* rsf h)                       ; row centers
  116.               wf  (Cdr (Assoc 41 ts))             ; character width factor
  117.               CharSiz (* wf h)                    ; character width
  118.               CharOS (* CharSiz cof)              ; character offset
  119.               x   (+ sx CharOS)
  120.               y   (- sy (- rc (/ (* (1- rsf) h) 2)))
  121.               cols (Car size)
  122.               rows (Cadr size)
  123.               colwid (read (Read-Line fp))        ; column width List
  124.               row 1
  125.         )
  126.         (InitGet "Yes No")
  127.         (If (/= "No" (getkword "\nCreate table grid?<Yes>: "))
  128.       (DrawGrid))
  129.     (princ "\nLoading text entities...")
  130.         (While (<= row rows) (Progn
  131.           (SetQ line (Read-Line fp))
  132.           (SetQ col 0
  133.                 tx x)
  134.           (If (> row 1)
  135.             (SetQ y (- y rc)))
  136.           (If line
  137.             (SetQ cells (read line))
  138.           ;else
  139.             (SetQ cells nil)
  140.           )
  141.           (ForEach cell cells
  142.             (If(> col 0)
  143.               (SetQ lcw (Nth (1- col) colwid)
  144.                     tx  (+ tx (* 2 CharOS) (* lcw CharSiz)))
  145.             )
  146.             (SetQ Just (Car cell)
  147.                   cw   (Nth col colwid))
  148.             (Cond ((= Just 1)
  149.                    (SetQ pt (List tx y))
  150.                   )
  151.                   ((= Just 2)
  152.                    (SetQ pt (List (+ tx (/ (* cw CharSiz) 2)) y)
  153.                          j "c")
  154.                   )
  155.                   ((= Just 3)
  156.                    (SetQ pt (List (- (+ tx (* cw CharSiz))(* 0.7 CharSiz)) y)
  157.                          j "r")
  158.                   )
  159.                   ((= Just 4)
  160.                    (SetQ pt (List (+ tx (* cw CharSiz)) y)
  161.                          j "r")
  162.                   )
  163.             )
  164.             (Command ".text")
  165.             (If (> Just 1)
  166.               (Command j))
  167.             (Command pt)
  168.             (If (Not hmode)
  169.               (Command h))
  170.             (Command 0 (Cadr cell))
  171.             (SetQ col (1+ col))
  172.           )
  173.           (SetQ row (1+ row))
  174.         ))
  175.         (Princ "\nTab123 finished...")
  176.       )
  177.         (Princ"\nNo Table Loaded...")
  178.       )
  179.     )
  180.   )
  181.   (Moder)
  182.   (setq *error* olderr)               ; Restore old *error* handler
  183.   (Princ)
  184. )
  185.  
  186. ;;; Execute Read_WKS
  187.  
  188. (Defun c:LoadTab ()
  189.   (If (SetQ fp (open "ACAD.123" "w"))
  190.     (close fp))                         ;just as good as erasing it
  191.   (Command "shell" "READ_WKS.EXE /A /I")
  192.   (Princ)
  193. )
  194.  
  195. ;;; Get a floating point value
  196.  
  197. (Defun GtReal( txt dflt / val )
  198.   (SetQ val (GetReal (strcat txt "<" (rtos dflt 2 2) ">:")))
  199.   (If val
  200.     val
  201.     dflt)
  202. )
  203.  
  204. ;;; Prompt / report parameters
  205.  
  206. (Defun GetParms ( / cmd )
  207.   (Princ(strcat "\nParameters: Row Scale Factor[" (rtos rsf 2 2)
  208.                 "] Character Offset Factor[" (rtos cof 2 2) "]"
  209.   ))
  210.   (InitGet "RowScaleFactor CharOffsetFactor Exit")
  211.   (SetQ cmd (getkword "\nRowScaleFactor/CharOffsetFactor/Exit/<Exit>:"))
  212.   (Cond ((= cmd "RowScaleFactor")
  213.         (SetQ rsf (GtReal "\nEnter Row Scale Factor" rsf)))
  214.         ((= cmd "CharOffsetFactor")
  215.         (SetQ cof (GtReal "\nEnter Character Offset Factor" cof)))
  216.   )
  217.   (Princ)
  218. )
  219.  
  220. ;;; The Main program
  221. (Defun c:Tab123 ( / cmd )
  222.   (InitGet "Load Draw All Parms Exit")
  223.   (SetQ cmd (getkword "\nLoad/Draw/All/Parms/Exit/<All>:"))
  224.   (If (Not cmd)
  225.     (SetQ cmd "All"))
  226.   (Cond ((= cmd "All")
  227.           (c:LoadTab)
  228.           (c:DrawTab)
  229.         )
  230.         ((= cmd "Load")
  231.           (c:LoadTab)
  232.         )
  233.         ((= cmd "Draw")
  234.           (c:DrawTab)
  235.         )
  236.         ((= cmd "Parms")
  237.           (GetParms)
  238.         )
  239.   )
  240.   (Princ)
  241. )
  242.  
  243. (Princ "\nTab123 version 1.3 loaded\nEnter TAB123 to execute.")
  244. (Princ)
  245.  
  246.